perm filename TDEK2.PAS[WEB,ALS] blob
sn#625334 filedate 1981-11-20 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00008 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {2}{4}{$C-,A+,D-}{[$C+,D+]}
C00006 00003 {18}{PROCEDURE DEBUGHELP
C00020 00004 {59} PROCEDURE Storetwobyte(x:sixteenbits)
C00030 00005 {82} PROCEDURE Flushbuffer
C00045 00006 {109} PROCEDURE Getline
C00058 00007 {134} PROCEDURE Scanrepl(t:eightbits)
C00068 00008 {149}{PROCEDURE DEBUGHELP
C00072 ENDMK
C⊗;
{2}{4}{$C-,A+,D-}{[$C+,D+]}
PROGRAM Tangle(input,output,pool,tty);
LABEL
9999;
CONST
{7}bufsize=100;
maxbytes=30000;
maxtoks=65535;
maxnames=4000;
maxtexts=2000;
hashsize=353;
longestname=300;
linelength=72;
outbufsize=144;
stacksize=50;
maxidlength=12;
unambiglengt=7;
TYPE
{12}asciifile=FILE OF char;
asciicode=0..127;
{25}eightbits=0..255;
sixteenbits=0..65535;
{27}namepointer=0..maxnames;
{30}textpointer=0..maxtexts;
{64}outputstate=RECORD endfield:sixteenbits;
bytefield:sixteenbits;
namefield:namepointer;
replfield:textpointer;
END;
VAR
{13}pool:asciifile;
{15}buffer:ARRAY[0..bufsize]OF asciicode;
{17}phaseone:boolean;
{26}bytemem:PACKED ARRAY[0..maxbytes]OF asciicode;
tokmem:PACKED ARRAY[0..maxtoks]OF eightbits;
bytestart:ARRAY[0..maxnames]OF sixteenbits;
tokstart:ARRAY[0..maxtexts]OF sixteenbits;
link:ARRAY[0..maxnames]OF sixteenbits;
ilk:ARRAY[0..maxnames]OF sixteenbits;
equiv:ARRAY[0..maxnames]OF sixteenbits;
textlink:ARRAY[0..maxtexts]OF sixteenbits;
{28}nameptr:namepointer;
stringptr:namepointer;
byteptr:0..maxbytes;
{31}textptr:textpointer;
tokptr:0..maxtoks;
{MAXTOKPTR:0..MAXTOKS;}{36}idfirst:0..bufsize;
idloc:0..bufsize;
doublechars:0..bufsize;
hash,chophash:ARRAY[0..hashsize]OF sixteenbits;
choppedid:ARRAY[0..unambiglengt]OF asciicode;
{51}module:ARRAY[0..longestname]OF asciicode;
{56}lastunnamed:textpointer;
{65}curstate:outputstate;
stack:ARRAY[1..stacksize]OF outputstate;
stackptr:0..stacksize;
{67}bracelevel:eightbits;
{71}curval:integer;
{79}outbuf:ARRAY[0..outbufsize]OF asciicode;
outptr:0..outbufsize;
breakptr:0..outbufsize;
semiptr:0..outbufsize;
{80}outstate:eightbits;
outval,outapp:integer;
outsign:asciicode;
{85}outcontrib:ARRAY[1..linelength]OF asciicode;
{107}page:sixteenbits;
line:sixteenbits;
limit:0..bufsize;
loc:0..bufsize;
inputhasende:boolean;
{115}curmodule:namepointer;
{126}nextcontrol:eightbits;
{133}currepltext:textpointer;
{139}modulecount:0..12287;
{147}{TROUBLESHOOT:BOOLEAN;DDT:SIXTEENBITS;DD:SIXTEENBITS;
DEBUGCYCLE:INTEGER;DEBUGSKIPPED:INTEGER;}
{18}{PROCEDURE DEBUGHELP;
FORWARD;}{19}
PROCEDURE Error;
VAR
j:0..outbufsize;
k,l:0..bufsize;
BEGIN
IF phaseone THEN
{20}
BEGIN
Writeln(tty,'. (p.',page:0,',l.',line:0,')');
IF loc>=limit THEN
l:=limit
ELSE
l:=loc;
FOR k:=1 TO l DO
IF buffer[k-1]=9 THEN
Write(tty,' ')
ELSE
Write(tty,Chr(buffer[k-1]));
Writeln(tty,'');
FOR k:=1 TO l DO Write(tty,' ');
FOR k:=l+1 TO limit DO Write(tty,Chr(buffer[k-1]));
Write(tty,' ');
END
ELSE
{21}
BEGIN
Writeln(tty,'. (l.',line:0,')');
FOR j:=1 TO outptr DO Write(tty,Chr(outbuf[j-1]));
Write(tty,'...');
END;
{DEBUGHELP;}
END;
{22}
PROCEDURE Quit;
BEGIN
GOTO 9999;
END;
PROCEDURE Initialize;
VAR
{37}h:0..hashsize;
BEGIN{14}
Rewrite(pool,'','/O');
IF NOT Eof(pool)THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Couldn''t open the pool file.');
END;
Quit;
END;
{29}nameptr:=1;
stringptr:=128;
byteptr:=1;
bytestart[0]:=1;
bytestart[1]:=1;
{32}tokptr:=1;
textptr:=1;
tokstart[0]:=1;
tokstart[1]:=1;
{34}ilk[0]:=0;
equiv[0]:=0;
{38}
FOR h:=0 TO hashsize-1 DO
BEGIN
hash[h]:=0;
chophash[h]:=0;
END;
{57}lastunnamed:=0;
textlink[0]:=0;
{122}module[0]:=32;
{148}{TROUBLESHOOT:=TRUE;DEBUGCYCLE:=1;DEBUGSKIPPED:=0;
TROUBLESHOOT:=FALSE;DEBUGCYCLE:=99999;}
END;
{11}
FUNCTION Openinput:boolean;
BEGIN
Reset(input,'','/E/I/O');
Openinput:=Eof(input);
END;
{16}
FUNCTION Inputln:boolean;
BEGIN
Readln;
IF Eof(input)THEN
Inputln:=false
ELSE
BEGIN
limit:=0;
buffer[0]:=Ord(input↑);
IF buffer[0]<>12 THEN
WHILE buffer[limit]<>13 DO
IF limit=bufsize-1 THEN
BEGIN
buffer[limit]:=13;
BEGIN
Writeln(tty);
Write(tty,'! Input line too long');
END;
Error;
END
ELSE
BEGIN
limit:=limit+1;
Get(input);
IF Eof(input)THEN
buffer[limit]:=13
ELSE
buffer[limit]:=Ord(input↑);
END;
Inputln:=true;
END;
END;
{35}
PROCEDURE Printid(p:namepointer);
VAR
k:0..maxbytes;
BEGIN
IF p>=nameptr THEN
Write(tty,'IMPOSSIBLE')
ELSE
FOR k:=bytestart[p]
TO bytestart[p+1]-1 DO Write(tty,Chr(bytemem[k]));
END;
{39}
FUNCTION Idlookup(t:eightbits):namepointer;
LABEL
31,32;
VAR
c:eightbits;
i:0..bufsize;
h:0..hashsize;
k:0..maxbytes;
l:0..bufsize;
p,q:namepointer;
s:0..unambiglengt;
BEGIN
l:=idloc-idfirst;
{40}h:=buffer[idfirst];
i:=idfirst+1;
WHILE i<idloc DO
BEGIN
h:=(h+h+buffer[i])MOD hashsize;
i:=i+1;
END;
{41}p:=hash[h];
WHILE p<>0 DO
BEGIN
IF bytestart[p+1]-bytestart[p]=l THEN
{42}
BEGIN
i:=
idfirst;
k:=bytestart[p];
WHILE(i<idloc)AND(buffer[i]=bytemem[k])DO
BEGIN
i:=i+1;
k:=k+1;
END;
IF i=idloc THEN
GOTO 31;
END;
p:=link[p];
END;
p:=nameptr;
link[p]:=hash[h];
hash[h]:=p;
31:;
IF(p=nameptr)OR(t<>0)THEN
{43}
BEGIN
IF((p<>nameptr)AND(t<>0)AND(ilk[p]=0)
)OR((p=nameptr)AND(t=0)AND(buffer[idfirst]<>34))THEN
{44}
BEGIN
i:=idfirst;
s:=0;
h:=0;
WHILE(i<idloc)AND(s<unambiglengt)DO
BEGIN
IF buffer[i]<>24 THEN
BEGIN
IF buffer[i]>=97 THEN
choppedid[s]:=buffer[i]-32
ELSE
choppedid[s]:=buffer[i];
h:=(h+h+choppedid[s])MOD hashsize;
s:=s+1;
END;
i:=i+1;
END;
choppedid[s]:=0;
END;
IF p<>nameptr THEN
{45}
BEGIN
IF ilk[p]=0 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! This identifier has already appeared');
Error;
END;
{46}q:=chophash[h];
IF q=p THEN
chophash[h]:=equiv[p]
ELSE
BEGIN
WHILE equiv[q]<>p DO q:=equiv[q];
equiv[q]:=equiv[p];
END;
END
ELSE
BEGIN
Writeln(tty);
Write(tty,'! This identifier was defined before');
Error;
END;
ilk[p]:=t;
END
ELSE
{47}
BEGIN
IF(t=0)AND(buffer[idfirst]<>34)THEN
{48}
BEGIN
q:=
chophash[h];
WHILE q<>0 DO
BEGIN{49}
BEGIN
k:=bytestart[q];
s:=0;
WHILE(k<bytestart[q+1])AND(s<unambiglengt)DO
BEGIN
c:=bytemem[k];
IF c<>24 THEN
BEGIN
IF c>=97 THEN
c:=c-32;
IF choppedid[s]<>c THEN GOTO 32;
s:=s+1;
END;
k:=k+1;
END;
IF(k=bytestart[q+1])AND(choppedid[s]<>0)THEN
GOTO 32;
BEGIN
Writeln(tty);
Write(tty,'! Identifier conflict with ');
END;
FOR k:=bytestart[q]TO bytestart[q+1]-1 DO
Write(tty,Chr(bytemem[k]));
Error;
q:=0;
32:
END;
q:=equiv[q];
END;
equiv[p]:=chophash[h];
chophash[h]:=p;
END;
IF byteptr+l>maxbytes THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','byte memory',' capacity exceeded');
Error;
Quit;
END;
IF nameptr=maxnames THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
i:=idfirst;
k:=byteptr;
WHILE i<idloc DO
BEGIN
bytemem[k]:=buffer[i];
k:=k+1;
i:=i+1;
END;
byteptr:=k;
nameptr:=nameptr+1;
bytestart[nameptr]:=k;
IF buffer[idfirst]<>34 THEN
ilk[p]:=t
ELSE
{50}
BEGIN
ilk[p]:=1;
IF l-doublechars=2 THEN
equiv[p]:=buffer[idfirst+1]+32768
ELSE
BEGIN
equiv[p]:=stringptr+32768;
stringptr:=stringptr+1;
Write(pool,Chr(31+l-doublechars));
i:=idfirst+1;
WHILE i<idloc DO
BEGIN
Write(pool,Chr(buffer[i]));
IF(buffer[i]=34)OR(buffer[i]=64)THEN
i:=i+2
ELSE
i:=i+1;
END;
END;
END;
END;
END;
Idlookup:=p;
END;
{52}
FUNCTION Modlookup(l:sixteenbits):namepointer;
LABEL
31;
VAR
c:(less,equal,greater,prefix,extension);
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
BEGIN
c:=greater;
q:=0;
p:=ilk[0];
WHILE p<>0 DO
BEGIN{54}
BEGIN
k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1
;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN
c:=equal
ELSE
c:=extension
ELSE
IF j>l THEN
c:=prefix
ELSE
IF module[j]<bytemem[k]THEN c:=less
ELSE c:=greater;
END;
q:=p;
IF c=less THEN p:=link[q]
ELSE IF c=greater THEN p:=ilk[q]
ELSE GOTO 31;
END;
{53}
IF byteptr+l>maxbytes THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','byte memory',' capacity exceeded');
Error;
Quit;
END;
IF nameptr=maxnames THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
p:=nameptr;
IF c=less THEN link[q]:=p
ELSE ilk[q]:=p;
link[p]:=0;
ilk[p]:=0;
c:=equal;
FOR j:=1 TO l DO bytemem[byteptr+j-1]:=module[j];
byteptr:=byteptr+l;
nameptr:=nameptr+1;
bytestart[nameptr]:=byteptr;
31:
IF c<>equal THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Incompatible module names');
Error;
END;
p:=0;
END;
Modlookup:=p;
END;
{55}
FUNCTION Prefixlookup(l:sixteenbits):namepointer;
LABEL 31;
VAR
c:(less,equal,greater,prefix,extension);
count:0..maxnames;
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
r:namepointer;
BEGIN
q:=0;
p:=ilk[0];
count:=0;
r:=0;
WHILE p<>0 DO
BEGIN{54}
BEGIN
k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN c:=equal
ELSE c:=extension
ELSE IF j>l THEN c:=prefix
ELSE IF module[j]<bytemem[k]THEN c:=less
ELSE c:=greater;
END;
IF c=less THEN p:=link[p]
ELSE IF c=greater THEN p:=ilk[p]
ELSE
BEGIN
r:=p;
count:=count+1;
q:=ilk[p];
p:=link[p];
END;
IF p=0 THEN
BEGIN
p:=q;
q:=0;
END;
END;
IF count<>1 THEN
IF count=0 THEN
BEGIN
Writeln(tty);
Write(tty,'! Name does not match');
Error;
END
ELSE
BEGIN
Writeln(tty);
Write(tty,'! Ambiguous prefix');
Error;
END;
Prefixlookup:=r;
END;
{59} PROCEDURE Storetwobyte(x:sixteenbits);
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=x DIV 256;
tokmem[tokptr+1]:=x MOD 256;
tokptr:=tokptr+2;
END;
{60}{PROCEDURE PRINTREPL(P:TEXTPOINTER);VAR K:0..MAXTOKS;
A:SIXTEENBITS;
BEGIN IF P>=TEXTPTR THEN WRITE(TTY,'BAD')ELSE BEGIN K:=TOKSTART[P];
WHILE K<TOKSTART[P+1]DO BEGIN A:=TOKMEM[K];
IF A>=128 THEN[61]BEGIN K:=K+1;
IF A<168 THEN BEGIN A:=(A-128)*256+TOKMEM[K];PRINTID(A);
IF BYTEMEM[BYTESTART[A]]=34 THEN WRITE(TTY,'"')ELSE WRITE(TTY,' ');
END ELSE IF A<208 THEN BEGIN WRITE(TTY,'@<');
PRINTID((A-168)*256+TOKMEM[K]);WRITE(TTY,'@>');
END ELSE BEGIN A:=(A-208)*256+TOKMEM[K];
WRITE(TTY,'@{',A:0,'@',CHR(126));END;
END ELSE[62]CASE A OF 9:WRITE(TTY,'@{');10:WRITE(TTY,'@',CHR(126));
12:WRITE(TTY,'@''');13:WRITE(TTY,'#');64:WRITE(TTY,'@@');
OTHERS:WRITE(TTY,CHR(A))END;K:=K+1;END;END;END;
}
{69}
PROCEDURE Pushlevel(p:namepointer);
BEGIN
IF stackptr=stacksize THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','stack',' capacity exceeded');
Error;
Quit;
END
ELSE
BEGIN
stack[stackptr]:=curstate;
stackptr:=stackptr+1;
curstate.namefield:=p;
curstate.replfield:=equiv[p];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
END;
END;
{70}
PROCEDURE Poplevel;
LABEL
10;
BEGIN
IF textlink[curstate.replfield]=0 THEN
BEGIN
IF ilk[curstate.
namefield]=3 THEN
{76}
BEGIN
{IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;}
nameptr:=nameptr-1;
textptr:=textptr-1;
tokptr:=tokstart[textptr];
{BYTEPTR:=BYTEPTR-1;}
END;
END
ELSE
IF textlink[curstate.replfield]<maxtexts THEN
BEGIN
curstate.
replfield:=textlink[curstate.replfield];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
GOTO 10;
END;
stackptr:=stackptr-1;
IF stackptr>0 THEN curstate:=stack[stackptr];
10:
END;
{72}
FUNCTION Getoutput:sixteenbits;
LABEL
20,30;
VAR
a:sixteenbits;
b:eightbits;
bal:sixteenbits;
BEGIN
20:
IF stackptr=0 THEN a:=0
ELSE
BEGIN
IF curstate.bytefield=curstate.endfield THEN
BEGIN
Poplevel;
GOTO 20;
END;
a:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF a<128 THEN
BEGIN
IF a=13 THEN
{77}
BEGIN
Pushlevel(nameptr-1);
GOTO 20;
END;
END
ELSE
BEGIN
a:=(a-128)*256+tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF a<10240 THEN
{74}
BEGIN
CASE ilk[a]OF
0:BEGIN
curval:=a;
a:=130;
END;
1:BEGIN
curval:=equiv[a]-32768;
a:=128;
END;
2:BEGIN
Pushlevel(a);
GOTO 20;
END;
3:BEGIN{75}
WHILE(curstate.bytefield=curstate.endfield)AND(stackptr>0)DO
Poplevel;
IF(stackptr=0)OR(tokmem[curstate.bytefield]<>40)THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! No parameter given for ');
END;
Printid(a);
Error;
GOTO 20;
END;
{78}bal:=1;
curstate.bytefield:=curstate.bytefield+1;
WHILE true DO
BEGIN
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF b=13 THEN
Storetwobyte(nameptr+32767)
ELSE
BEGIN
IF b>=128 THEN
BEGIN
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
END
ELSE
CASE b OF
40:bal:=bal+1;
41:BEGIN
bal:=bal-1;
IF bal=0 THEN
GOTO 30;
END;
39:REPEAT
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
UNTIL b=39;
OTHERS:
END;
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
END;
END;
30:;
equiv[nameptr]:=textptr;
ilk[nameptr]:=2;
{IF BYTEPTR=MAXBYTES THEN BEGIN WRITELN(TTY);
WRITE(TTY,'! Sorry, ','byte memory',' capacity exceeded');
ERROR;QUIT;
END;BYTEMEM[BYTEPTR]:=35;BYTEPTR:=BYTEPTR+1;}
IF nameptr=maxnames THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
nameptr:=nameptr+1;
bytestart[nameptr]:=byteptr;
IF textptr=maxtexts THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','text',' capacity exceeded');
Error;
Quit;
END;
textlink[textptr]:=0;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
Pushlevel(a);
GOTO 20;
END;
OTHERS:BEGIN
Writeln(tty);
Write(tty,'! This can''t happen (','output',')');
Error;
Quit;
END
END
END
ELSE
IF a<20480 THEN
{73}
BEGIN
a:=a-10240;
IF equiv[a]<>0 THEN
Pushlevel(a)
ELSE
IF a<>0 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Not present: <');
END;
Printid(a);
Write(tty,'>');
Error;
END;
GOTO 20;
END
ELSE
BEGIN
curval:=a-20480;
a:=129;
END;
END;
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}
Getoutput:=a;
END;
{82} PROCEDURE Flushbuffer;
VAR
k:0..outbufsize;
b:0..outbufsize;
BEGIN
b:=breakptr;
IF(semiptr<>0)AND(outptr-semiptr<=linelength)THEN
breakptr:=semiptr;
FOR k:=1 TO breakptr DO Write(Chr(outbuf[k-1]));
Writeln;
line:=line+1;
IF line MOD 100=0 THEN
Write(tty,'.');
IF breakptr<outptr THEN
BEGIN
IF outbuf[breakptr]=32 THEN
breakptr:=
breakptr+1;
FOR k:=breakptr TO outptr-1 DO outbuf[k-breakptr]:=outbuf[k];
END;
outptr:=outptr-breakptr;
breakptr:=b-breakptr;
semiptr:=0;
IF outptr>linelength THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Long line must be truncated');
Error;
END;
outptr:=linelength;
END;
END;
{84}
PROCEDURE Appval(v:integer);
VAR k:0..outbufsize;
BEGIN
k:=outbufsize;
REPEAT
outbuf[k]:=v MOD 10;
v:=v DIV 10;
k:=k-1;
UNTIL v=0;
REPEAT
k:=k+1;
BEGIN
outbuf[outptr]:=outbuf[k]+48;
outptr:=outptr+1;
END;
UNTIL k=outbufsize;
END;
{86}
PROCEDURE Sendout(t:eightbits; v:sixteenbits);
LABEL 20;
VAR k:0..linelength;
BEGIN{87}
20:
CASE outstate OF
1:IF t<>3 THEN
BEGIN
breakptr:=outptr;
IF t=2 THEN
BEGIN
outbuf[outptr]:=32;
outptr:=outptr+1;
END;
END;
2:BEGIN
BEGIN
outbuf[outptr]:=44-outapp;
outptr:=outptr+1;
END;
IF outptr>linelength THEN
Flushbuffer;
breakptr:=outptr;
END;
3,4:BEGIN{88}
IF outval<0 THEN
BEGIN
outbuf[outptr]:=45;
outptr:=outptr+1;
END
ELSE
IF outsign>0 THEN
BEGIN
outbuf[outptr]:=outsign;
outptr:=outptr+1;
END;
Appval(Abs(outval));
IF outptr>linelength THEN
Flushbuffer;
;
outstate:=outstate-2;
GOTO 20;
END;
5:{89}BEGIN
IF(t=3)OR({90}((t=2)AND(v=3)AND(((outcontrib[1]=68)
AND(outcontrib[2]=73)AND(outcontrib[3]=86))
OR((outcontrib[1]=77)AND(outcontrib[2]=79)
AND(outcontrib[3]=68))))OR((t=0)AND((v=42)OR(v=47)))) THEN
BEGIN{88}
IF outval<0 THEN
BEGIN
outbuf[outptr]:=45;
outptr:=outptr+1;
END
ELSE
IF outsign>0 THEN
BEGIN
outbuf[outptr]:=outsign;
outptr:=outptr+1;
END;
Appval(Abs(outval));
IF outptr>linelength THEN Flushbuffer;
outsign:=43;
outval:=outapp;
END
ELSE outval:=outval+outapp;
outstate:=3;
GOTO 20;
END;
0:IF t<>3 THEN breakptr:=outptr;
OTHERS:
END;
IF t<>0 THEN
FOR k:=1 TO v DO
BEGIN
outbuf[outptr]:=outcontrib[k];
outptr:=outptr+1;
END
ELSE
BEGIN
outbuf[outptr]:=v;
outptr:=outptr+1;
END;
IF outptr>linelength THEN Flushbuffer;
IF(t=0)AND(v=59)THEN
BEGIN
semiptr:=outptr;
breakptr:=outptr;
END;
IF t>=2 THEN
outstate:=1
ELSE
outstate:=0
END;
{91}
PROCEDURE Sendsign(v:integer);
BEGIN
CASE outstate OF
2,4:outapp:=outapp*v;
3:BEGIN
outapp:=v;
outstate:=4;
END;
5:BEGIN
outval:=outval+outapp;
outapp:=v;
outstate:=4;
END;
OTHERS:BEGIN
breakptr:=outptr;
outapp:=v;
outstate:=2;
END
END;
END;
{92}
PROCEDURE Sendval(v:integer);
LABEL
666,10;
BEGIN
CASE outstate OF
1:BEGIN{95}
IF(outptr=breakptr+3)
OR((outptr=breakptr+4)AND(outbuf[breakptr]=32))THEN
IF((outbuf[outptr-3]=68)AND(outbuf[outptr-2]=73)
AND(outbuf[outptr-1]=86))OR((outbuf[outptr-3]=77)
AND(outbuf[outptr-2]=79)AND(outbuf[outptr-1]=68))THEN
GOTO 666;
outsign:=32;
outstate:=3;
outval:=v;
breakptr:=outptr;
END;
0:BEGIN{94}
IF(outptr=breakptr+1)AND((outbuf[breakptr]=42)
OR(outbuf[breakptr]=47))THEN
GOTO 666;
outsign:=0;
outstate:=3;
outval:=v;
breakptr:=outptr;
END;
{93}2:BEGIN
outsign:=43;
outstate:=3;
outval:=outapp*v;
END;
3:BEGIN
outstate:=5;
outapp:=v;
END;
4:BEGIN
outstate:=5;
outapp:=outapp*v;
END;
5:BEGIN
outval:=outval+outapp;
outapp:=v;
END;
OTHERS:GOTO 666
END;
GOTO 10;
666:{96}
IF v>=0 THEN
BEGIN
IF outstate=1 THEN
BEGIN
breakptr:=outptr;
BEGIN
outbuf[outptr]:=32;
outptr:=outptr+1;
END;
END;
Appval(v);
IF outptr>linelength THEN Flushbuffer;
outstate:=1;
END
ELSE
BEGIN
BEGIN
outbuf[outptr]:=40;
outptr:=outptr+1;
END;
BEGIN
outbuf[outptr]:=45;
outptr:=outptr+1;
END;
Appval(-v);
BEGIN
outbuf[outptr]:=41;
outptr:=outptr+1;
END;
IF outptr>linelength THEN Flushbuffer;
outstate:=0;
END;
10:
END;
{98}
PROCEDURE Sendtheoutpu;
LABEL 2,21,22;
VAR
curchar:eightbits;
k:0..linelength;
j:0..maxbytes;
n:integer;
BEGIN
WHILE stackptr>0 DO
BEGIN
curchar:=Getoutput;
21:
CASE curchar OF
0:;
{101}65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,
87,88,89,90:BEGIN
outcontrib[1]:=curchar;
Sendout(2,1);
END;
97,98,99,100,101,102,103,104,105,
106,107,108,109,110,111,112,113,114,115,
116,117,118,119,120,121,122:
BEGIN
outcontrib[1]:=curchar-32;
Sendout(2,1);
END;
130:BEGIN
k:=0;
j:=bytestart[curval];
WHILE(k<maxidlength)AND(j<bytestart[curval+1])DO
BEGIN
k:=k+1;
outcontrib[k]:=bytemem[j];
j:=j+1;
IF outcontrib[k]>=97 THEN
outcontrib[k]:=outcontrib[k]-32
ELSE IF outcontrib[k]=24 THEN k:=k-1;
END;
Sendout(2,k);
END;
{103}48,49,50,51,52,53,54,55,56,57:
BEGIN
n:=0;
REPEAT
n:=10*n+curchar-48;
curchar:=Getoutput;
UNTIL(curchar>57)OR(curchar<48);
Sendval(n);
k:=0;
IF curchar=101 THEN curchar:=69;
IF curchar=69 THEN GOTO 2
ELSE GOTO 21;
END;
12:BEGIN
n:=0;
curchar:=48;
REPEAT
n:=8*n+curchar-48;
curchar:=Getoutput;
UNTIL(curchar>55)OR(curchar<48);
Sendval(n);
GOTO 21;
END;
128:Sendval(curval);
46:BEGIN
k:=1;
outcontrib[1]:=46;
curchar:=Getoutput;
IF curchar=46 THEN
BEGIN
outcontrib[2]:=46;
Sendout(1,2);
END
ELSE
IF(curchar>=48)AND(curchar<=57)THEN GOTO 2
ELSE
BEGIN
Sendout(0,46);
GOTO 21;
END;
END;
43,45:Sendsign(44-curchar);
{99}4:BEGIN
outcontrib[1]:=65;
outcontrib[2]:=78;
outcontrib[3]:=68;
Sendout(2,3);
END;
5:BEGIN
outcontrib[1]:=78;
outcontrib[2]:=79;
outcontrib[3]:=84;
Sendout(2,3);
END;
6:BEGIN
outcontrib[1]:=73;
outcontrib[2]:=78;
Sendout(2,2);
END;
31:BEGIN
outcontrib[1]:=79;
outcontrib[2]:=82;
Sendout(2,2);
END;
95:BEGIN
outcontrib[1]:=58;
outcontrib[2]:=61;
Sendout(1,2);
END;
27:BEGIN
outcontrib[1]:=60;
outcontrib[2]:=62;
Sendout(1,2);
END;
28:BEGIN
outcontrib[1]:=60;
outcontrib[2]:=61;
Sendout(1,2);
END;
29:BEGIN
outcontrib[1]:=62;
outcontrib[2]:=61;
Sendout(1,2);
END;
30:BEGIN
outcontrib[1]:=61;
outcontrib[2]:=61;
Sendout(1,2);
END;
32:BEGIN
outcontrib[1]:=46;
outcontrib[2]:=46;
Sendout(1,2);
END;
39:{102}BEGIN
k:=1;
outcontrib[1]:=39;
REPEAT
IF k<linelength THEN k:=k+1;
outcontrib[k]:=Getoutput;
UNTIL(outcontrib[k]=39)OR(stackptr=0);
IF k=linelength THEN
BEGIN
Writeln(tty);
Write(tty,'! String too long');
Error;
END;
Sendout(1,k);
curchar:=Getoutput;
IF curchar=39 THEN outstate:=6;
GOTO 21;
END;
{100}33,34,35,36,37,38,40,41,42,
44,47,58,59,60,61,62,63,64,91,92,93,94,
24,96,123,124,126:Sendout(0,curchar);
{105}9:BEGIN
IF bracelevel=0 THEN Sendout(0,123)
ELSE Sendout(0,91);
bracelevel:=bracelevel+1;
END;
10:IF bracelevel>0 THEN
BEGIN
bracelevel:=bracelevel-1;
IF bracelevel=0 THEN Sendout(0,126)
ELSE Sendout(0,93);
END
ELSE
BEGIN
Writeln(tty);
Write(tty,'! Extra @}');
Error;
END;
129:IF bracelevel=0 THEN
BEGIN
Sendout(0,123);
Sendval(curval);
Sendout(0,126);
END
ELSE
BEGIN
Sendout(0,91);
Sendval(curval);
Sendout(0,93);
END;
127:BEGIN
Sendout(3,0);
outstate:=6;
END;
OTHERS:BEGIN
Writeln(tty);
Write(tty,'! Can''t output ascii code ',curchar:0);
Error;
END
END;
GOTO 22;
2:{104}
REPEAT
IF k<linelength THEN k:=k+1;
outcontrib[k]:=curchar;
curchar:=Getoutput;
IF(outcontrib[k]=69)AND((curchar=43)OR(curchar=45))THEN
BEGIN
IF k<linelength THEN k:=k+1;
outcontrib[k]:=curchar;
curchar:=Getoutput;
END
ELSE IF curchar=101 THEN curchar:=69;
UNTIL(curchar<>69)AND((curchar<48)OR(curchar>57));
IF k=linelength THEN
BEGIN
Writeln(tty);
Write(tty,'! Fraction too long');
Error;
END;
Sendout(3,k);
GOTO 21;
22:
END;
END;
{109} PROCEDURE Getline;
BEGIN
IF buffer[0]=12 THEN
line:=0;
IF Inputln THEN
BEGIN
IF line=0 THEN
BEGIN
page:=page+1;
Write(tty,page:0,' ');
{110}
IF(page=1)AND(limit=29)THEN
IF(buffer[0]=67)AND(buffer[8]=22)THEN
REPEAT
IF Inputln THEN
ELSE
BEGIN
limit:=0;
buffer[0]:=12;
END;
UNTIL buffer[0]=12;
END;
IF buffer[limit]=13 THEN buffer[limit]:=32;
END
ELSE IF buffer[0]<>12 THEN
BEGIN
limit:=0;
buffer[0]:=12;
END
ELSE inputhasende:=true;
line:=line+1;
loc:=0;
END;
{111}
FUNCTION Controlcode(c:asciicode):eightbits;
BEGIN
CASE c OF
64:Controlcode:=64;
39:Controlcode:=12;
32,9,42:Controlcode:=137;
68,100:Controlcode:=133;
70,102:Controlcode:=132;
123:Controlcode:=9;
126:Controlcode:=10;
80,112:Controlcode:=134;
84,116,94,46:Controlcode:=131;
38:Controlcode:=127;
60:Controlcode:=135;
OTHERS:Controlcode:=0
END;
END;
{112}
FUNCTION Skipahead:eightbits;
LABEL 30;
VAR c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
c:=136;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
IF loc<=limit THEN
BEGIN
loc:=loc+2;
c:=Controlcode(buffer[loc-1]);
IF(c<>0)OR(buffer[loc-1]=62)THEN
GOTO 30;
END;
END;
30:
Skipahead:=c;
END;
{113}
PROCEDURE Skipcomment;
LABEL 10;
VAR
bal:eightbits;
c:asciicode;
BEGIN
bal:=0;
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Page ended in mid-comment');
Error;
END;
loc:=1;
GOTO 10;
END;
END;
c:=buffer[loc];
loc:=loc+1;
{114}
IF c=64 THEN
BEGIN
c:=buffer[loc];
IF(c<>32)AND(c<>9)AND(c<>42)THEN
loc:=loc+1
ELSE
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Module ended in mid-comment');
Error;
END;
loc:=loc-1;
GOTO 10;
END
END
ELSE
IF(c=92)AND(buffer[loc]<>64)THEN
loc:=loc+1
ELSE
IF c=123
THEN
bal:=bal+1
ELSE
IF c=126 THEN
BEGIN
IF bal=0 THEN GOTO 10;
bal:=bal-1;
END;
END;
10:
END;
{116}
FUNCTION Getnext:eightbits;
LABEL 20,30;
VAR
c:eightbits;
d:eightbits;
j,k:0..longestname;
BEGIN
20:
IF loc>limit THEN
Getline;
c:=buffer[loc];
loc:=loc+1;
CASE c OF
65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,
81,82,83,84,85,86,87,88,89,90,97,98,99,100,101,
102,103,104,105,106,107,108,109,110,111 ,112,113,
114,115,116,117,118,119,120,121,122:
{118}BEGIN
loc:=loc-1;
idfirst:=loc;
REPEAT
loc:=loc+1;
d:=buffer[loc];
UNTIL((d<48)OR((d>57)AND(d<65))OR((d>90)AND(d<97))
OR(d>122))AND(d<>24);
IF loc>idfirst+1 THEN
BEGIN
c:=130;
idloc:=loc;
END;
END;
34:{119}BEGIN
doublechars:=0;
idfirst:=loc-1;
REPEAT
d:=buffer[loc];
loc:=loc+1;
IF(d=34)OR(d=64)THEN
IF buffer[loc]=d THEN
BEGIN
loc:=loc+1;
d:=0;
doublechars:=doublechars+1;
END
ELSE
IF d=64 THEN
BEGIN
Writeln(tty);
Write(tty,'! Double @ sign missing');
Error;
END
ELSE
IF loc>limit THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! String constant didn''t end');
Error;
END;
d:=34;
END;
UNTIL d=34;
idloc:=loc-1;
c:=130;
END;
64:{120}BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
IF c=0 THEN GOTO 20
ELSE
IF c=135 THEN
{121}
BEGIN{123}
k:=0;
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Page ended in module name');
Error;
END;
loc:=1;
GOTO 30;
END;
END;
d:=buffer[loc];
{124}
IF d=64 THEN
BEGIN
d:=buffer[loc+1];
IF d=62 THEN
BEGIN
loc:=loc+2;
GOTO 30;
END;
IF(d=32)OR(d=9)OR(d=42)THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Module name didn''t end');
Error;
END;
GOTO 30;
END;
k:=k+1;
module[k]:=64;
loc:=loc+1;
END;
loc:=loc+1;
IF k<longestname-1 THEN
k:=k+1;
IF(d=32)OR(d=9)THEN
BEGIN
d:=32;
IF module[k-1]=32 THEN
k:=k-1;
END;
module[k]:=d;
END;
30:{125}
IF k>=longestname-2 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Module name too long: ');
END;
FOR j:=1 TO 25 DO Write(tty,Chr(module[j]));
Write(tty,'...');
END;
IF(module[k]=32)AND(k>0)THEN
k:=k-1;
IF k>3 THEN
BEGIN
IF(module[k]=46)AND(module[k-1]=46)
AND(module[k-2]=46) THEN
curmodule:=Prefixlookup(k-3)
ELSE curmodule:=Modlookup(k);
END
ELSE curmodule:=Modlookup(k);
END
ELSE
IF c=131 THEN
BEGIN
REPEAT
c:=Skipahead;
UNTIL c<>64;
IF buffer[loc-1]<>62 THEN
BEGIN
Writeln(tty);
Write(tty,'! Improper @ within control text');
Error;
END;
GOTO 20;
END;
END;
{117}46:IF buffer[loc]=46 THEN
BEGIN
c:=32;
loc:=loc+1;
END;
58:IF buffer[loc]=61 THEN
BEGIN
c:=95;
loc:=loc+1;
END;
61:IF buffer[loc]=61 THEN
BEGIN
c:=30;
loc:=loc+1;
END;
62:IF buffer[loc]=61 THEN
BEGIN
c:=29;
loc:=loc+1;
END;
60:IF buffer[loc]=61 THEN
BEGIN
c:=28;
loc:=loc+1;
END
ELSE
IF buffer[loc]=62 THEN
BEGIN
c:=27;
loc:=loc+1;
END;
40:IF buffer[loc]=42 THEN
BEGIN
c:=9;
loc:=loc+1;
END;
42:IF buffer[loc]=41 THEN
BEGIN
c:=10;
loc:=loc+1;
END;
32,9:GOTO 20;
123:BEGIN
Skipcomment;
GOTO 20;
END;
12:c:=136;
OTHERS:
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}Getnext:=c;
END;
{127}
PROCEDURE Scannumeric(p:namepointer);
LABEL 21,30;
VAR
accumulator:integer;
nextsign:-1..+1;
q:namepointer;
val:integer;
PROCEDURE Addin(v:integer);
BEGIN
accumulator:=accumulator+nextsign*v;
nextsign:=+1;
END;
BEGIN{128}
accumulator:=0;
nextsign:=+1;
WHILE true DO
BEGIN
nextcontrol:=Getnext;
21:
CASE nextcontrol OF
48,49,50,51,52,53,54,55,56,57:
BEGIN{130}
val:=0;
REPEAT
val:=10*val+nextcontrol-48;
nextcontrol:=Getnext;
UNTIL(nextcontrol>57)OR(nextcontrol<48);
Addin(val);
GOTO 21;
END;
12:BEGIN{131}
val:=0;
nextcontrol:=48;
REPEAT
val:=8*val+nextcontrol-48;
nextcontrol:=Getnext;
UNTIL(nextcontrol>55)OR(nextcontrol<48);
Addin(val);
GOTO 21;
END;
130:BEGIN
q:=Idlookup(0);
IF ilk[q]<>1 THEN
BEGIN
nextcontrol:=42;
GOTO 21;
END;
Addin(equiv[q]-32768);
END;
43:;
45:nextsign:=-nextsign;
132,133,135,134,136,137:GOTO 30;
59:BEGIN
Writeln(tty);
Write(tty,'! Omit semicolon in numeric definition');
Error;
END;
OTHERS:{129}BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Improper numeric definition will be flushed');
Error;
END;
REPEAT
nextcontrol:=Skipahead
UNTIL(nextcontrol>=132);
IF nextcontrol=135 THEN
BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
END;
accumulator:=0;
GOTO 30;
END
END;
END;
30:;
IF Abs(accumulator)>=32768 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Value too big: ',accumulator:0);
Error;
END;
accumulator:=0;
END;
equiv[p]:=accumulator+32768;
END;
{134} PROCEDURE Scanrepl(t:eightbits);
LABEL 22,30,31;
VAR
a:sixteenbits;
b:asciicode;
bal:eightbits;
BEGIN
bal:=0;
WHILE true DO
BEGIN
22:
a:=Getnext;
CASE a OF
40:bal:=bal+1;
41:IF bal=0 THEN
BEGIN
Writeln(tty);
Write(tty,'! Extra )');
Error;
END
ELSE
bal:=bal-1;
39:{137}BEGIN
b:=39;
WHILE true DO
BEGIN
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
IF b=64 THEN
IF buffer[loc]=64 THEN
loc:=loc+1
ELSE
BEGIN
Writeln(tty);
Write(tty,'! You should double @ signs in strings');
Error;
END;
IF loc=limit THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! String didn''t end');
Error;
END;
buffer[loc]:=39;
buffer[loc+1]:=0;
END;
b:=buffer[loc];
loc:=loc+1;
IF b=39 THEN
BEGIN
IF buffer[loc]<>39 THEN
GOTO 31
ELSE
BEGIN
loc:=loc+1
;
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=39;
tokptr:=tokptr+1;
END;
END;
END;
END;
31:
END;
35:IF t=3 THEN
a:=13;
{136}130:BEGIN
a:=Idlookup(0);
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=(a DIV 256)+128;
tokptr:=tokptr+1;
END;
a:=a MOD 256;
END;
135:IF t<>135 THEN
GOTO 30
ELSE
BEGIN
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=(curmodule DIV 256)+168;
tokptr:=tokptr+1;
END;
a:=curmodule MOD 256;
END;
133,132,134:IF t<>135 THEN
GOTO 30
ELSE
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! @',Chr(buffer[loc-1]),' is ignored in PASCAL text');
Error;
END;
GOTO 22;
END;
136,137:GOTO 30;
OTHERS:
END;
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=a;
tokptr:=tokptr+1;
END;
END;
30:
nextcontrol:=a;
{135}
IF bal>0 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Missing ',bal:0,' )');
Error;
END;
WHILE bal>0 DO
BEGIN
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=41;
tokptr:=tokptr+1;
END;
bal:=bal-1;
END;
END;
IF textptr=maxtexts THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','text',' capacity exceeded');
Error;
Quit;
END;
currepltext:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
{138}
PROCEDURE Definemacro(t:eightbits);
VAR p:namepointer;
BEGIN
p:=Idlookup(t);
Scanrepl(t);
equiv[p]:=currepltext;
textlink[currepltext]:=0;
END;
{140}
PROCEDURE Scanmodule;
LABEL
30,10;
VAR p:namepointer;
BEGIN
modulecount:=modulecount+1;
{141}nextcontrol:=0;
WHILE true DO
BEGIN
22:
WHILE nextcontrol<=132 DO
BEGIN
nextcontrol:=Skipahead;
IF nextcontrol=135 THEN
BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
END;
END;
IF nextcontrol<>133 THEN GOTO 30;
nextcontrol:=Getnext;
IF nextcontrol<>130 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Definition flushed, must start with ',
'identifier of length > 1');
Error;
END;
GOTO 22;
END;
nextcontrol:=Getnext;
IF nextcontrol=61 THEN
BEGIN
Scannumeric(Idlookup(1));
GOTO 22;
END
ELSE
IF nextcontrol=30 THEN
BEGIN
Definemacro(2);
GOTO 22;
END
ELSE
{142}
IF nextcontrol=40 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=35 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=41 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=61 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Use == for macros');
Error;
END;
nextcontrol:=30;
END;
IF nextcontrol=30 THEN
BEGIN
Definemacro(3);
GOTO 22;
END;
END;
END;
END;
;
BEGIN
Writeln(tty);
Write(tty,'! Definition flushed since it starts badly');
Error;
END;
END;
30:;
{143}
CASE nextcontrol OF
134:p:=0;
135:BEGIN
p:=curmodule;
{144}
REPEAT nextcontrol:=Getnext;
UNTIL nextcontrol<>43;
IF(nextcontrol<>61)AND(nextcontrol<>30)THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! PASCAL text flushed, = sign is missing');
Error;
END;
REPEAT
nextcontrol:=Skipahead;
UNTIL nextcontrol>=136;
GOTO 10;
END;
END;
OTHERS:GOTO 10
END;
{145}Storetwobyte(53248+modulecount);
Scanrepl(135);
{146}
IF p=0 THEN
BEGIN
textlink[lastunnamed]:=currepltext;
lastunnamed:=currepltext;
END
ELSE
IF equiv[p]=0 THEN
equiv[p]:=currepltext
ELSE
BEGIN
p:=equiv[p]
;
WHILE textlink[p]<maxtexts DO p:=textlink[p];
textlink[p]:=currepltext;
END;
textlink[currepltext]:=maxtexts;
10:
END;
{149}{PROCEDURE DEBUGHELP;
LABEL 888,10;
VAR K:SIXTEENBITS;
BEGIN
DEBUGSKIPPED:=DEBUGSKIPPED+1;
IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;
DEBUGSKIPPED:=0;
888:
['*****************************breakpoint*****************************']
WHILE TRUE DO
BEGIN WRITE(TTY,'#');
READ(TTY,DDT);
IF DDT<0 THEN GOTO 10
ELSE IF DDT=0 THEN GOTO 888;
READ(TTY,DD);
CASE DDT OF
1:PRINTID(DD);
2:PRINTREPL(DD);
3:FOR K:=1 TO DD DO WRITE(TTY,CHR(BUFFER[K]));
4:FOR K:=1 TO DD DO WRITE(TTY,CHR(MODULE[K]));
5:FOR K:=1 TO OUTPTR DO WRITE(TTY,CHR(OUTBUF[K]));
6:FOR K:=1 TO DD DO WRITE(TTY,CHR(OUTCONTRIB[K]));
OTHERS:WRITE(TTY,'?')END;
END;
10:END;
}
{150}
BEGIN
Initialize;
{108}
IF Openinput THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Couldn''t open the input file.');
END;
Quit;
END;
page:=0;
line:=0;
limit:=0;
loc:=1;
buffer[0]:=32;
inputhasende:=false;
{151}phaseone:=true;
modulecount:=0;
REPEAT
nextcontrol:=Skipahead;
WHILE nextcontrol=137 DO Scanmodule;
UNTIL inputhasende;
phaseone:=false;
{MAXTOKPTR:=TOKPTR;}{97}
IF textlink[0]=0 THEN
BEGIN
Writeln(tty);
Write(tty,'! No output was specified.');
END
ELSE
BEGIN
BEGIN
Writeln(tty);
Write(tty,'Writing the output file...');
END;
{68}stackptr:=1;
bracelevel:=0;
curstate.namefield:=0;
curstate.replfield:=textlink[0];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
{81}outstate:=0;
outptr:=0;
breakptr:=0;
semiptr:=0;
outbuf[0]:=0;
line:=1;
Sendtheoutpu;
{83}
IF(outstate<>0)OR(outbuf[breakptr]<>46)THEN
BEGIN
Writeln(tty);
Write(tty,'! Program didn''t end with period');
Error;
END;
breakptr:=outptr;
semiptr:=0;
Flushbuffer;
BEGIN
Writeln(tty);
Write(tty,'Done.');
END;
END;
9999:
IF stringptr>128 THEN
BEGIN
Writeln(tty);
Write(tty,stringptr-128:0,' strings written to string pool file.');
END;
{[152]
BEGIN
WRITELN(TTY);
WRITE(TTY,'Memory usage statistics:');
END;
BEGIN WRITELN(TTY);
WRITE(TTY,NAMEPTR:0,' names, ',TEXTPTR:0,' replacement texts;');
END;
BEGIN WRITELN(TTY);
WRITE(TTY,BYTEPTR:0,' bytes, ',MAXTOKPTR:0,' tokens.');
END;;}
END.